home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / BBS-Archive / Dev / Obrn-A_1.6_lib.lha / oberon-a / source3.lha / source / Library / In.mod < prev    next >
Text File  |  1995-06-29  |  11KB  |  434 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: In.mod $
  4.   Description: Formatted input from the standard input stream.
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 1.3 $
  8.       $Author: fjc $
  9.         $Date: 1995/01/26 00:40:27 $
  10.  
  11.   Copyright © 1994-1995, Frank Copeland.
  12.   This file is part of the Oberon-A Library.
  13.   See Oberon-A.doc for conditions of use and distribution.
  14.  
  15. *************************************************************************)
  16.  
  17. MODULE In;
  18.  
  19. (**
  20. ** Extracts from the Oakwood Report are enclosed in quotes.
  21. **
  22. ** "Module In provides a set of basic routines for formatted input of
  23. ** characters, character sequences, numbers, and names. It assumes a
  24. ** standard input stream with a current position that can be reset to
  25. ** the beginning of the stream."
  26. **
  27. ** This implementation uses the standard AmigaDOS input stream provided
  28. ** through the Input() system function as the source of characters.
  29. *)
  30.  
  31. IMPORT SYS := SYSTEM, Dos, DosUtil, WbConsole, Reals, Sets;
  32.  
  33. (**
  34. ** "Done indicates the success of an input operation. If Done is TRUE
  35. ** after an input operation, the operation was successful and its result
  36. ** is valid. An unsuccessful input operation sets Done to FALSE; it
  37. ** remains FALSE until the next call to Open(). In particular, Done is set
  38. ** to FALSE if an attempt is made to read beyond the end of the input
  39. ** stream."
  40. *)
  41.  
  42. VAR
  43.  
  44.   Done -: BOOLEAN;
  45.  
  46. (*
  47. ** eof is set by Read(), and is TRUE if an attempt to read from the
  48. ** standard input fails.
  49. **
  50. ** nameChars is used in Scan() to determine which characters are legal in
  51. ** AmigaDos filenames.
  52. *)
  53.  
  54. VAR
  55.  
  56.   eof : BOOLEAN;
  57.   nameChars : Sets.CharSet;
  58.  
  59. CONST
  60.  
  61.   (* symbol classes *)
  62.  
  63.   inval  = 0; (* invalid symbol *)
  64.   name   = 1; (* name s *)
  65.   string = 2; (* literal string s *)
  66.   int    = 3; (* integer i (decimal or hexadecimal) *)
  67.   real   = 4; (* real number rval *)
  68.   lreal  = 5; (* long real number lrval *)
  69.   char   = 6; (* special character c *)
  70.  
  71.   TAB = 9X; CR = 0DX; LF = 0AX; (* Amiga end-of-line character *)
  72.   maxStr = 256;
  73.  
  74. (* Results from Scan *)
  75.  
  76. VAR
  77.  
  78.   class : INTEGER;
  79.   ival  : LONGINT;
  80.   rval  : REAL;
  81.   lrval : LONGREAL;
  82.   cval  : CHAR;
  83.   sval  : ARRAY maxStr OF CHAR;
  84.  
  85.  
  86. PROCEDURE Read ( VAR ch : CHAR );
  87.  
  88.   VAR i : LONGINT;
  89.  
  90. BEGIN (* Read *)
  91.   DosUtil.HaltIfBreak ({Dos.ctrlC});
  92.   IF ~eof THEN
  93.     i := Dos.FGetC (Dos.Input());
  94.     IF i >= 0 THEN ch := CHR (i)
  95.     ELSE ch := 0X; eof := TRUE
  96.     END
  97.   END
  98. END Read;
  99.  
  100.  
  101. PROCEDURE ScanName;
  102.  
  103.   VAR
  104.     ch : CHAR;
  105.     i : SHORTINT;
  106.     ignore : LONGINT;
  107.  
  108. BEGIN (* ScanName *)
  109.   Read (ch); i := 0;
  110.   LOOP
  111.     IF (ch # " ") & (ch # TAB) THEN EXIT END;
  112.     Read (ch)
  113.   END;
  114.   IF (CAP (ch) >= "A") & (CAP (ch) <= "Z") THEN (* name *)
  115.     (*
  116.     ** AmigaDos filenames can include all printable characters. Full path
  117.     ** names can include ":" and "/", but ":" can only appear once, and
  118.     ** must come before any "/".
  119.     *)
  120.     nameChars.Clear;
  121.     nameChars.InclChRange (" ", "~"); nameChars.InclChRange (0A1X, 0FFX);
  122.     REPEAT
  123.       IF (ch = ":") OR (ch = "/") THEN nameChars.ExclCh (":") END;
  124.       sval [i] := ch; INC (i); Read (ch)
  125.     UNTIL ~nameChars.ContainsCh (ch) OR (i = (maxStr - 1));
  126.     sval [i] := 0X; class := name;
  127.     IF ~eof & (ch # CR) & (ch # LF) THEN
  128.       ignore := Dos.UnGetC (Dos.Input(), -1)
  129.     END
  130.   ELSIF  (ch = CR) OR (ch = LF) THEN
  131.     sval := ""; class := name
  132.   ELSE
  133.     class := inval;
  134.     IF ~eof THEN ignore := Dos.UnGetC (Dos.Input(), -1) END
  135.   END
  136. END ScanName;
  137.  
  138.  
  139. PROCEDURE ScanStr;
  140.  
  141.   VAR ch : CHAR; i : SHORTINT; ignore : LONGINT;
  142.  
  143. BEGIN (* ScanStr *)
  144.   Read (ch); i := 0;
  145.   LOOP
  146.     IF (ch # " ") & (ch # TAB) THEN EXIT END;
  147.     Read (ch)
  148.   END;
  149.   IF ch = 22X THEN (* literal string *)
  150.     Read (ch);
  151.     WHILE (ch # 22X) & (ch >= " ") & (i # (maxStr - 1)) DO
  152.       sval [i] := ch; INC (i); Read (ch)
  153.     END;
  154.     sval [i] := 0X; class := string;
  155.     IF ch # 22X THEN Done := FALSE END
  156.   ELSIF  (ch = CR) OR (ch = LF) THEN
  157.     sval := ""; class := string
  158.   ELSE
  159.     class := inval;
  160.     IF ~eof THEN ignore := Dos.UnGetC (Dos.Input(), -1) END
  161.   END
  162. END ScanStr;
  163.  
  164.  
  165. PROCEDURE ScanNum;
  166.  
  167.   CONST
  168.     maxD = 32;
  169.     (* Limits for exponents *)
  170.     MaxExp = 38; (* REAL : IEEE single-precision *)
  171.     MaxLExp = 38; (* LONGREAL : IEEE single-precision *)
  172.  
  173.   VAR
  174.     ch : CHAR;
  175.     neg, negE, hex : BOOLEAN;
  176.     i, j, h : SHORTINT;
  177.     e : INTEGER; k, ignore : LONGINT;
  178.     x, f : REAL; y, g : LONGREAL;
  179.     d : ARRAY maxD OF CHAR;
  180.  
  181.   (*------------------------------------*)
  182.   PROCEDURE ReadScaleFactor ();
  183.  
  184.   BEGIN (* ReadScaleFactor *)
  185.     Read (ch);
  186.     IF ch = "-" THEN negE := TRUE; Read (ch)
  187.     ELSE negE := FALSE; IF ch = "+" THEN Read (ch) END;
  188.     END;
  189.     WHILE (ch >= "0") & (ch <= "9") DO
  190.       e := e * 10 + ORD (ch) - 30H; Read (ch)
  191.     END;
  192.     IF ~eof THEN ignore := Dos.UnGetC (Dos.Input(), -1) END
  193.   END ReadScaleFactor;
  194.  
  195. BEGIN (* ScanNum *)
  196.   Read (ch); i := 0;
  197.   LOOP
  198.     IF (ch # CR) & (ch # LF) & (ch # " ") & (ch # TAB) THEN EXIT END;
  199.     Read (ch)
  200.   END;
  201.   IF (CAP (ch) >= "A") & (CAP (ch) <= "Z") THEN (* name *)
  202.     IF ~eof THEN ignore := Dos.UnGetC (Dos.Input(), -1) END;
  203.     class := inval
  204.   ELSIF ch = 22X THEN (* literal string *)
  205.     IF ~eof THEN ignore := Dos.UnGetC (Dos.Input(), -1) END;
  206.     class := inval
  207.   ELSE
  208.     IF ch = "-" THEN neg := TRUE; Read (ch) ELSE neg := FALSE END;
  209.     IF (ch >= "0") & (ch <= "9") THEN (* number *)
  210.       hex := FALSE; j := 0;
  211.       LOOP
  212.         d [i] := ch; INC (i); Read (ch);
  213.         IF ch < "0" THEN EXIT END;
  214.         IF "9" < ch THEN
  215.           IF ("A" <= ch) & (ch <= "F") THEN
  216.             hex := TRUE; ch := CHR (ORD (ch) - 7)
  217.           ELSIF ("a" <= ch) & (ch <= "f") THEN
  218.             hex := TRUE; ch := CHR (ORD (ch) - 27H)
  219.           ELSE
  220.             EXIT
  221.           END
  222.         END
  223.       END;
  224.       IF ch = "H" THEN (* hex number *)
  225.         class := int;
  226.         IF i - j > 8 THEN j := i - 8 END;
  227.         k := ORD (d [j]) - 30H; INC (j);
  228.         IF (i - j = 7) & (k >= 8) THEN DEC (k, 16) END;
  229.         WHILE j < i DO k := k * 10H + (ORD (d [j]) - 30H); INC (j) END;
  230.         IF neg THEN ival := -k ELSE ival := k END;
  231.       ELSIF ch = "." THEN (* read real *)
  232.         Read (ch); h := i;
  233.         WHILE Done & ("0" <= ch) & (ch <= "9") DO
  234.           d [i] := ch; INC (i); Read (ch)
  235.         END;
  236.         IF ch = "D" THEN
  237.           e := 0; y := 0.0; g := 1.0;
  238.           REPEAT y := y * 10.0 + (ORD (d [j]) - 30H); INC (j) UNTIL j = h;
  239.           WHILE j < i DO
  240.             g := g / 10.0; y := (ORD (d [j]) - 30H) * g + y; INC (j)
  241.           END;
  242.           ReadScaleFactor;
  243.           IF negE THEN
  244.             IF e <= MaxLExp THEN y := y / Reals.TenL (e) ELSE y := 0.0 END
  245.           ELSIF e > 0 THEN
  246.             IF e <= MaxLExp THEN y := y * Reals.TenL (e) ELSE HALT (40) END
  247.           END;
  248.           IF neg THEN y := -y END;
  249.           class := lreal; lrval := y
  250.         ELSE
  251.           e := 0; x := 0.0; f := 1.0;
  252.           REPEAT x := x * 10.0 + (ORD (d [j]) - 30H); INC (j) UNTIL j = h;
  253.           WHILE j < i DO
  254.             f := f / 10.0; x := (ORD (d [j]) - 30H) * f + x; INC (j)
  255.           END;
  256.           IF ch = "E" THEN ReadScaleFactor
  257.           ELSIF ~eof THEN ignore := Dos.UnGetC (Dos.Input(), -1)
  258.           END;
  259.           IF negE THEN
  260.             IF e <= MaxExp THEN x := x / Reals.Ten (e) ELSE x := 0.0 END
  261.           ELSIF e > 0 THEN
  262.             IF e <= MaxExp THEN x := x * Reals.Ten (e) ELSE HALT (40) END
  263.           END;
  264.           IF neg THEN x := -x END;
  265.           class := real; rval := x
  266.         END; (* ELSE *)
  267.         IF hex THEN class := inval END
  268.       ELSE (* decimal integer *)
  269.         IF ~eof THEN ignore := Dos.UnGetC (Dos.Input(), -1) END;
  270.         class := int; k := 0;
  271.         REPEAT k := k * 10 + (ORD (d [j]) - 30H); INC (j) UNTIL j = i;
  272.         IF neg THEN ival := -k ELSE ival := k END;
  273.         IF hex THEN class := inval ELSE class := int END
  274.       END
  275.     ELSE
  276.       class := char;
  277.       IF neg THEN cval := "-" ELSE cval := ch END
  278.     END
  279.   END
  280. END ScanNum;
  281.  
  282.  
  283. (**
  284. ** "Open() (re)sets the current position to the beginning of the input
  285. ** stream. Done indicates if the operation was successful."
  286. *)
  287.  
  288. PROCEDURE Open*;
  289.  
  290.   VAR ignore : LONGINT; in : Dos.FileHandlePtr;
  291.  
  292. BEGIN (* Open *)
  293.   Done := FALSE; in := Dos.Input();
  294.   IF in # NIL THEN
  295.     IF Dos.Flush (in) THEN
  296.       ignore := Dos.Seek (in, 0, Dos.beginning);
  297.       Done := TRUE; eof := FALSE
  298.     END
  299.   END
  300. END Open;
  301.  
  302.  
  303. (**
  304. ** "Char(ch) returns the character ch at the current position."
  305. *)
  306.  
  307. PROCEDURE Char* ( VAR ch : CHAR );
  308.  
  309. BEGIN (* Char *)
  310.   IF Done THEN Read (ch); Done := ~eof END
  311. END Char;
  312.  
  313.  
  314. (**
  315. ** "LongInt(n) and Int(n) return the (long) integer constant n at the
  316. ** current position according to the format:
  317. **
  318. **   IntConst = digit {digit} | digit {hexDigit} "H"."
  319. *)
  320.  
  321. PROCEDURE LongInt* ( VAR n : LONGINT );
  322.  
  323. BEGIN (* LongInt *)
  324.   IF Done THEN
  325.     ScanNum;
  326.     IF class = int THEN n := ival
  327.     ELSE Done := FALSE
  328.     END
  329.   END;
  330. END LongInt;
  331.  
  332.  
  333. PROCEDURE Int* ( VAR n : INTEGER );
  334.  
  335.   VAR i : LONGINT;
  336.  
  337. BEGIN (* Int *)
  338.   LongInt (i);
  339.   IF Done THEN
  340.     IF (i >= MIN (INTEGER)) & (i <= MAX (INTEGER)) THEN n := SHORT (i)
  341.     ELSE Done := FALSE
  342.     END
  343.   END
  344. END Int;
  345.  
  346.  
  347. (*
  348. ** "Real(n) returns the real constant n at the current position according
  349. ** to the format:
  350. **
  351. **   RealConst =
  352. **     digit {digit} ["." {digit} ["E" [("+"|"-")] digit {digit}]]."
  353. *)
  354.  
  355. PROCEDURE Real* ( VAR num : REAL );
  356.  
  357. BEGIN (* Real *)
  358.   IF Done THEN
  359.     ScanNum;
  360.     IF class = int THEN num := ival
  361.     ELSIF class = real THEN num := rval
  362.     ELSE Done := FALSE
  363.     END
  364.   END;
  365. END Real;
  366.  
  367.  
  368. (*
  369. ** "LongReal(n) returns the long real constant n at the current position
  370. ** according to the format:
  371. **
  372. **   LongRealConst =
  373. **     digit {digit} ["." {digit} [("D"|"E") [("+"|"-")] digit {digit}]]."
  374. *)
  375.  
  376. PROCEDURE LongReal* ( VAR num : LONGREAL );
  377.  
  378. BEGIN (* LongReal *)
  379.   IF Done THEN
  380.     ScanNum;
  381.     IF class = int THEN num := ival
  382.     ELSIF class = real THEN num := rval
  383.     ELSIF class = lreal THEN num := lrval
  384.     ELSE Done := FALSE
  385.     END
  386.   END;
  387. END LongReal;
  388.  
  389.  
  390. (*
  391. ** String(s) returns the string s at the current position according to the
  392. ** format:
  393. **
  394. **   StringConstant = '"' char {char} '"'."
  395. **
  396. ** The string must not contain characters less than blank such as EOL or
  397. ** TAB.
  398. *)
  399.  
  400. PROCEDURE String* ( VAR str : ARRAY OF CHAR );
  401.  
  402. BEGIN (* String *)
  403.   IF Done THEN
  404.     ScanStr;
  405.     IF class = string THEN COPY (sval, str)
  406.     ELSE Done := FALSE
  407.     END
  408.   END;
  409. END String;
  410.  
  411.  
  412. (*
  413. ** "Name(s) returns the name s at the current position according to the
  414. ** file name format of the underlying operating system (e.g.
  415. ** "lib/My.Mod" under Unix)."
  416. *)
  417.  
  418. PROCEDURE Name* ( VAR n : ARRAY OF CHAR );
  419.  
  420. BEGIN (* Name *)
  421.   IF Done THEN
  422.     ScanName;
  423.     IF class = name THEN COPY (sval, n)
  424.     ELSE Done := FALSE
  425.     END
  426.   END;
  427. END Name;
  428.  
  429.  
  430. <*$ClearVars+*>
  431. BEGIN
  432.   nameChars.Init (0)
  433. END In.
  434.